home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / boi120p.zip / UNITS.ZIP / ASYNC.PAS next >
Pascal/Delphi Source File  |  1990-12-09  |  7KB  |  194 lines
  1. {$D-}  { Debug Information Off }
  2. {$S-}  { Stack Checking Off    }
  3. {$V-}  { String Checking Off   }
  4.  
  5. Unit Async;
  6. { Part of BBS Onliner Interface }
  7. { Copyright (C) 1990 Andrew J. Mead
  8.   All Rights Reserved. }
  9.  
  10. { original version 9/5/90
  11.   history found in IOLIB.PAS }
  12.  
  13.  
  14. INTERFACE
  15.  
  16. Function CARRIER : boolean;                  { Carrier Detect function }
  17. Procedure DROPCARRIER;                       { Drop Carrier }
  18. Procedure ASYNCINT; Interrupt;               { Comport Interrupt Routine }
  19. Procedure SENDCHAR(outchar : char);          { Comport Output Routine }
  20. Function CHARREADY : boolean;                { Character Ready for Input }
  21. Function READBUFFER : char;                  { Get Character from buffer }
  22. Procedure CLEARINBUFFER;                     { Empty input buffer }
  23. Procedure SETBUFFERSIZE(newsize : integer);  { Set buffer size, defaul = 1k }
  24. Procedure INTINIT;                           { Install Comport Interrupt }
  25. Procedure INTEND;                            { Disable Comport Interrupt }
  26.  
  27. IMPLEMENTATION
  28.  
  29. Uses
  30.   boidecl,
  31.   iolib,
  32.   dos;
  33.  
  34. Const
  35.   null    = #0;
  36.   maxbuffsize = 1024;
  37.  
  38.   THRoff  = $00;  { 8250 UART Transmitter Holding Register offset         }
  39.   RBRoff  = $00;  { 8250 UART Receiver Buffer Register offset             }
  40.  
  41.   DLLoff  = $00;  { 8250 UART Divisor Latch Least Significant Byte offset }
  42.   DLMoff  = $01;  { 8250 UART Divisor Latch Most Significant Byte offset  }
  43.  
  44.   IERoff  = $01;  { 8250 UART Interrupt Enable Register offset            }
  45.   IIRoff  = $02;  { 8250 UART Interrupt Identification Register offset    }
  46.   LCRoff  = $03;  { 8250 UART Line Control Register offset                }
  47.   MCRoff  = $04;  { 8250 UART Modem Control Register offset               }
  48.   LSRoff  = $05;  { 8250 UART Line Status Register offset                 }
  49.   MSRoff  = $06;  { 8250 UART Modem Status Register offset                }
  50.  
  51.   PICCMD  = $20;  { 8259A Programmable Interrupt Controller Port }
  52.   PICMSK  = $21;  { 8259A Programmable Interrupt Controller Port }
  53.  
  54.   RTSbit  = $20;  { Ready To Send bit in LSR }
  55.   CTSbit  = $10;  { Clear To Send bit in MSR }
  56.   DCDbit  = $80;  { Data Carrier Detect (RLSD) bit in MSR }
  57.   DCval   = $08;  { changes carrier detect bit in MSR }
  58.   DTRhigh = $00;  { force DTR high value }
  59.  
  60. Type
  61.   portbufftype = array [1..maxbuffsize] of char;
  62.  
  63. Var
  64.   portbuffer  : portbufftype;  { Circular input buffer }
  65.   bufflimit   : integer;       { Current maximum buffer size }
  66.   buffsize    : integer;       { Number of character in buffer }
  67.   buffend     : integer;       { Index pointing to last character in buffer }
  68.   buffstart   : integer;       { Index pointing to first character in buffer }
  69.   asyncvector : pointer;       { original interrupt vector }
  70.   IIRstatus   : byte;          { 8250 UART IIR status byte }
  71.   LSRstatus   : byte;          { 8250 UART LCR status byte }
  72.  
  73. Function CARRIER : boolean;
  74. { This function will return 'true' if a carrier is present.}
  75.  
  76.   begin {* fCarrier *}
  77.     Carrier := dolocal or (not checkcd) or
  78.         ((port[portadd + MSRoff] and DCDbit) = DCDbit)
  79.   end;  {* fCarrier *}
  80.  
  81. Procedure DROPCARRIER;
  82. { This function will force the modem to hang up the phone.}
  83.   var
  84.     timebase : longint;
  85.  
  86.   begin {* DropCarrier *}
  87.     TimerSet(timebase);
  88.     repeat port[portadd + MCRoff] := DTRhigh
  89.     until GetTimer(timebase,2)
  90.   end;  {* DropCarrier *}
  91.  
  92. Procedure ASYNCINT;
  93.   begin {* AsyncInt *}
  94.     inline($FB);   { STI }
  95.     IIRstatus := port[portadd + IIRoff];  { read IIR status }
  96.     if ((IIRstatus and $06) = $04) then   { check to see if character waiting }
  97.       begin                               { place character in buffer }
  98.         if buffsize < bufflimit then
  99.           begin
  100.             portbuffer[buffend] := Char(Port[portadd + RBRoff]);
  101.             if buffend < bufflimit then Inc(buffend) else buffend := 1;
  102.             Inc(buffsize)
  103.           end
  104.         else LSRstatus := Port[portadd + RBRoff] { clear LSR status byte }
  105.       end
  106.     else if ((IIRstatus and $06) = $06) then LSRstatus := Port[portadd + RBRoff];
  107.     inline($FA);   { CLI }
  108.     port[PICCMD] := $20                   { reset 8259A PIC }
  109.   end;  {* AsyncInt *}
  110.  
  111. Procedure SENDCHAR(outchar : char);
  112.   var
  113.     timecnt  : word;
  114.     timebase : longint;
  115.  
  116.   begin {* SendChar *}
  117.     TimerSet(timebase);
  118.     timecnt := 0;
  119.     while (port[portadd + LSRoff] and RTSbit <> RTSbit) or { UART ready }
  120.         (baudlock and (port[portadd + MSRoff] and CTSbit <> CTSbit)) do
  121.       begin                                              { ^^ modem ready }
  122.         Inc(timecnt);
  123.         if not Carrier then DoTimeOut(false)
  124.         else if timecnt mod 1000 = 0 then if GetTimer(timebase,60) then DoTimeOut(false)
  125.       end;
  126.     port[portadd + RBRoff] := ord(outchar)            { send character }
  127.   end;  {* SendChar *}
  128.  
  129. Function CHARREADY : boolean;
  130.   begin {* fCharReady *}
  131.     CharReady := buffsize > 0
  132.   end;  {* fCharReady *}
  133.  
  134. Function READBUFFER : char;
  135.   var
  136.     rb : char;
  137.  
  138.   begin {* fReadBuffer *}
  139.     if CharReady then
  140.       begin
  141.         rb := portbuffer[buffstart];
  142.         if buffstart < bufflimit then Inc(buffstart) else buffstart := 1;
  143.         Dec(buffsize);
  144.         ReadBuffer := rb
  145.       end
  146.     else ReadBuffer := null
  147.   end;  {* fReadBuffer *}
  148.  
  149. Procedure CLEARINBUFFER;
  150.   begin {* ClearInBuffer *}
  151.     buffend := buffstart;
  152.     buffsize := 0
  153.   end;  {* ClearInBuffer *}
  154.  
  155. Procedure SETBUFFERSIZE(newsize : integer);
  156.   begin {* SetBufferSize *}
  157.     if (newsize > 1) and (newsize <= maxbuffsize) then
  158.       begin
  159.         buffstart := 1;
  160.         ClearInBuffer;
  161.         bufflimit := newsize
  162.       end;
  163.   end;  {* SetBufferSize *}
  164.  
  165. Procedure INTINIT;
  166.   var
  167.     inittemp : byte;
  168.  
  169.   begin {* IntInit *}
  170.     fillchar(portbuffer,sizeof(portbuffer),32);
  171.     buffend   := 1;
  172.     buffstart := 1;
  173.     buffsize  := 0;
  174.     bufflimit := maxbuffsize;
  175.     GetIntVec(portint,asyncvector);            { save old interrupt vector }
  176.     SetIntVec(portint,@AsyncInt);              { install AsyncInt vector }
  177.     Port[PICMSK] := Port[PICMSK] and initval;  { access 8259A PIC }
  178.     Port[portadd + LCRoff] := Port[portadd + LCRoff] and $7F;
  179.                                           { disable divisor latch register }
  180.     Port[portadd + IERoff] := $01;        { enable interrupts }
  181.     Port[portadd + MCRoff] := $0B;        { set RTS, DTR and OUT2 }
  182. {   Port[portadd + MSRoff] := $80; }
  183.     inittemp := Port[portadd + LSRoff];   { reset LSR }
  184.     Port[PICCMD] := $20                   { reset 8259A PIC }
  185.   end;  {* IntInit *}
  186.  
  187. Procedure INTEND;
  188.   begin {* IntEnd *}
  189.     SetIntVec(portint,asyncvector);       { re-install old interrupt vector }
  190.     Port[PICCMD] := $20                   { reset 8259A PIC }
  191.   end;  {* IntEnd *}
  192.  
  193. end.  Unit
  194.